Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/sftgrd/ini_file.bas

BASIC Source File | 1996-06-12 | 9.7 KB | 303 lines

': INI_FILE.BAS
'-    Manages writing info to Windows INI files
'
' Copyright 1994, AA-Software International
'     Distributed for non-commercial educational use only.
'     For other use contact:
'        AA-Software International
'        12 ter Domaine Du Bois Joli
'        06330 Roquefort-Les-Pins, France
'
'        Tel: [phone]
'        Fax: [phone]
'        Internet: [e-mail]
'        CompuServe: 100343,2570
'
Option Explicit
'
' Window API Function Declarations
'
Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal DEFAULT As Integer, ByVal FileName As String) As Integer
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal DEFAULT As String, ByVal ReturnedString As String, ByVal MaxSize As Integer, ByVal FileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal NewString As String, ByVal FileName As String) As Integer

Dim INI_FILENAME As String
Dim APP_NAME As String

Dim filesOpen_s() As String            'file name of the CAF files that are currently open

Sub ini_CloseFile (ByVal iniFile_h As Integer)

'-Closes a ini file.

   'Make sure handle is valid
   Rem gen_assert (0 < iniFile_h And iniFile_h <= UBound(filesOpen_s)), "ini_CloseFile", "Invalid ini file handle"

   'Mark the slot as unused by setting it to null string
   filesOpen_s(iniFile_h) = ""

End Sub

Function ini_GetFileName_s (ByVal iniFile_h As Integer) As String

   Rem gen_assert (0 < iniFile_h And iniFile_h <= UBound(filesOpen_s)), "ini_GetFileName_s", "Invalid ini file handle."
   Rem gen_assert (filesOpen_s(iniFile_h) <> ""), "ini_GetFileName_s", "Invalid ini file handle."

   ini_GetFileName_s = filesOpen_s(iniFile_h)

End Function

Function ini_GetMaxObjects_l (ByVal iniFile_h As Integer) As Long

   'Get the ini file name
   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   ini_GetMaxObjects_l = IniGetInteger2(iniFileName_s, "global info", "ObjectsMax", 0)

End Function

Function ini_GetObjectID_l (ByVal iniFile_h As Integer, ByVal keyName_s As String) As Long

   'Get the ini file name
   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   'Return the keyname for this object
   ini_GetObjectID_l = IniGetInteger2(iniFileName_s, keyName_s, "objectID", 0)


End Function

Function ini_GetObjectKeyName_s (ByVal iniFile_h As Integer, ByVal ObjectID_l As Long) As String

   'Get the ini file name
   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   'Return the keyname for this object
   ini_GetObjectKeyName_s = IniGetString2(iniFileName_s, "objectKeyname", "I" & Trim$(Str$(ObjectID_l)), "")

End Function

Function ini_GetObjectStatus_s (ByVal iniFile_h As Integer, ByVal ObjectID_l As Long) As String

   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   Dim keyName_s As String
   keyName_s = ini_GetObjectKeyName_s(iniFile_h, ObjectID_l)
   Rem gen_assert (keyName_s <> ""), "ini_GetObjectStatus_s", "Object does not exist"

   ini_GetObjectStatus_s = IniGetString2(iniFileName_s, keyName_s, "Status", "")

End Function

Sub ini_Initialize ()

   Static AlreadyInitialized_b As Integer

   If AlreadyInitialized_b Then
      Exit Sub
   End If

   ReDim filesOpen_s(0)
   AlreadyInitialized_b = True
End Sub

Function ini_OpenFile_h (ByVal fileName_s As String) As Integer

'-Open a ini file returing a handle.

   'find a empty filename slot
   Dim slot_i As Integer
   For slot_i = 1 To UBound(filesOpen_s)
      If filesOpen_s(slot_i) = "" Then Exit For
   Next slot_i

   'extend the number of filename slots if needed
   If slot_i > UBound(filesOpen_s) Then
      slot_i = slot_i + 1
      ReDim Preserve filesOpen_s(slot_i)
   End If

   'put filename into slot
   filesOpen_s(slot_i) = fileName_s

   'report back the slot number used
   ini_OpenFile_h = slot_i

End Function

Sub ini_SetObjectStatus (ByVal iniFile_h As Integer, ByVal ObjectID_l As Long, ByVal status_s As String)

   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   Dim keyName_s As String
   keyName_s = ini_GetObjectKeyName_s(iniFile_h, ObjectID_l)
   Rem gen_assert (keyName_s <> ""), "ini_GetObjectStatus_s", "Object does not exist"

   IniPutString2 iniFileName_s, keyName_s, "Status", status_s
End Sub

Function iniCreateObject_l (ByVal iniFile_h As Integer, ByVal keyName_s As String) As Long

   'Get the ini file name
   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   Dim ObjectID_l As Long
   ObjectID_l = IniGetInteger2(iniFileName_s, keyName_s, "objectID", 0)

   'Check if object exists
   If ObjectID_l = 0 Then
      'Object Not found, create new object
      ObjectID_l = pGetNextFreeObjectID_l(iniFile_h)
      'Set the keyname lookup
      IniPutString2 iniFileName_s, "objectKeyname", "I" & Format$(ObjectID_l), keyName_s
      IniPutInteger2 iniFileName_s, keyName_s, "objectID", ObjectID_l
   End If

   iniCreateObject_l = ObjectID_l

End Function

Sub IniGetForm (f As Form, ByVal formName$)
Dim APP_NAME As String

APP_NAME = formName$ + "-Position"
f.Left = GetPrivateProfileInt(APP_NAME, "Left", f.Left, INI_FILENAME)
f.Width = GetPrivateProfileInt(APP_NAME, "Width", f.Width, INI_FILENAME)
f.Top = GetPrivateProfileInt(APP_NAME, "Top", f.Top, INI_FILENAME)
f.Height = GetPrivateProfileInt(APP_NAME, "Height", f.Height, INI_FILENAME)
f.WindowState = GetPrivateProfileInt(APP_NAME, "WindowState", f.WindowState, INI_FILENAME)

End Sub

Function IniGetInteger (ByVal Key As String, ByVal DefaultValue As Integer) As Integer

    IniGetInteger = GetPrivateProfileInt(APP_NAME, Key, DefaultValue, INI_FILENAME)

End Function

Function IniGetInteger2 (ByVal iniFileName As String, ByVal sectionName As String, ByVal Key As String, ByVal DefaultValue As Integer) As Integer

   IniGetInteger2 = GetPrivateProfileInt(sectionName, Key, DefaultValue, iniFileName)

End Function

Function IniGetString (ByVal Key As String, ByVal DefaultValue As String) As String
Dim r As Integer
Dim retval As String

retval = Space$(255)
r = GetPrivateProfileString(APP_NAME, Key, DefaultValue, retval, Len(retval), INI_FILENAME)
retval = Trim$(retval)
IniGetString = Left$(retval, Len(retval) - 1)

End Function

Function IniGetString2 (ByVal iniFileName As String, ByVal sectionName As String, ByVal Key As String, ByVal DefaultValue As String) As String

   Dim retval As String
   retval = Space$(255)

   Dim r As Integer
   r = GetPrivateProfileString(sectionName, Key, DefaultValue, retval, Len(retval), iniFileName)
   retval = Trim$(retval)
   IniGetString2 = Left$(retval, Len(retval) - 1)

End Function

Sub IniPutForm (f As Form, ByVal formName$)
Dim r As Integer
Dim APP_NAME As String

APP_NAME = formName$ + "-Position"
r = WritePrivateProfileString(APP_NAME, "WindowState", Format$(f.WindowState), INI_FILENAME)

If f.WindowState = 0 Then   ' Do not update if full screen or inconed
    r = WritePrivateProfileString(APP_NAME, "Left", Format$(f.Left), INI_FILENAME)
    r = WritePrivateProfileString(APP_NAME, "Width", Format$(f.Width), INI_FILENAME)
    r = WritePrivateProfileString(APP_NAME, "Top", Format$(f.Top), INI_FILENAME)
    r = WritePrivateProfileString(APP_NAME, "Height", Format$(f.Height), INI_FILENAME)
End If
End Sub

Sub IniPutInteger (ByVal Key As String, ByVal Value As Long)
Dim r As Integer

    r = WritePrivateProfileString(APP_NAME, Key, Format$(Value), INI_FILENAME)

End Sub

Sub IniPutInteger2 (ByVal iniFileName As String, ByVal sectionName As String, ByVal Key As String, ByVal Value As Long)
   Dim r
   r = WritePrivateProfileString(sectionName, Key, Format$(Value), iniFileName)

End Sub

Sub IniPutString (ByVal Key As String, ByVal Value As String)
Dim r As Integer

    r = WritePrivateProfileString(APP_NAME, Key, Value, INI_FILENAME)

End Sub

Sub IniPutString2 (ByVal iniFileName As String, ByVal sectionName As String, ByVal Key As String, ByVal Value As String)
   Dim r
   r = WritePrivateProfileString(sectionName, Key, Value, iniFileName)

End Sub

Sub IniSetAppName (ByVal AppName As String)
    APP_NAME = AppName
End Sub

Sub IniSetFileName (ByVal IniFileName_c As String)
    INI_FILENAME = IniFileName_c
End Sub

Private Function pGetNextFreeObjectID_l (ByVal iniFile_h As Integer) As Long

  'Get the ini file name
   Dim iniFileName_s As String
   iniFileName_s = ini_GetFileName_s(iniFile_h)

   'Get maximum number of objects in iniFile
   Dim ObjectsMax_i As Integer
   ObjectsMax_i = ini_GetMaxObjects_l(iniFile_h)

   'Check if there are any deleted objects
   If IniGetInteger2(iniFileName_s, "global info", "ObjectsDeleted", 0) = 1 Then
      'scan looking for deleted object
      Dim controlKeyName_s As String

      Dim i As Long
      For i = 1 To ObjectsMax_i
         controlKeyName_s = ini_GetObjectKeyName_s(iniFile_h, i)
         If controlKeyName_s = "" Then
            'found a deleted object. i points to it.
            Exit For
         End If
      Next i
   Else
      i = ObjectsMax_i + 1
   End If

   ' i points to the correct objectID. It is either:
   '     pointing to a deleted object, or
   '     ObjectMax_i+1
   pGetNextFreeObjectID_l = i

   'Save out object reserved and delete info
   If i > ObjectsMax_i Then
      IniPutString2 iniFileName_s, "global info", "ObjectsMax", Str$(i)
      'There are no deleted objects.
      IniPutString2 iniFileName_s, "global info", "ObjectsDeleted", Str$(0)
   End If

End Function